Shareware Super Platinum 8/Shareware Super Platinum 8.iso/mac/EDITORS/AE170.ZIP;1/AE4.PAS

Pascal/Delphi Source File | 1993-03-24 | 37.2 KB | 900 lines

UNIT AE4 ;

{$R-}
{$B-}
{$I-}
{$S+}
{$V-}

INTERFACE

USES Crt, Dos, Printer, AE0, AE1, AE2, AE3 ;

FUNCTION CopyBlock : BOOLEAN ;
PROCEDURE DeleteBlock ;
FUNCTION InsertBlock : BOOLEAN ;
PROCEDURE PrintBlock (Buffer : WsBufptr ; BlockStart, BlockEnd : WORD ) ;
PROCEDURE InsertFile (Filename : PathStr; P : Position) ;
PROCEDURE LoadFile (Filename : PathStr) ;
PROCEDURE GetFileFromList (VAR Name : PathStr) ;
PROCEDURE InsertSpaces (VAR P : Position ; NrOfSpaces : WORD) ;
PROCEDURE InsertCRLF (VAR P : Position) ;
PROCEDURE RedrawScreen ;
PROCEDURE AlterSetup ;
PROCEDURE FormatParagraph (VAR P : position) ;

IMPLEMENTATION

{-----------------------------------------------------------------------------}
{ Copies the block in the current workspace to the paste buffer. If no block  }
{ is indicated or if the block is too large for the paste buffer, an error    }
{ message is given, and the function result will be False.                    }
{-----------------------------------------------------------------------------}

FUNCTION CopyBlock : BOOLEAN ;

VAR Result : BOOLEAN ;

BEGIN
Result := FALSE ;
WITH CurrentWs DO
     BEGIN
     IF (MARK > 0)
        THEN BEGIN
             IF MARK < CurPos.Index
                THEN BEGIN
                     IF (CurPos.Index - MARK) > PasteBufSize
                        THEN ErrorMessage (4)
                        ELSE BEGIN
                             PasteBufferSize := CurPos.Index - MARK ;
                             MOVE (Buffer^ [MARK], PasteBuffer^ [1],
                                   PasteBufferSize) ;
                             Result := TRUE ;
                             END ;
                     END
                ELSE BEGIN
                     IF (MARK - CurPos.Index) > PasteBufSize
                        THEN ErrorMessage (4)
                        ELSE BEGIN
                             PasteBufferSize := MARK - CurPos.Index ;
                             MOVE (Buffer^ [CurPos.Index], PasteBuffer^ [1],
                                   PasteBufferSize) ;
                             Result := TRUE ;
                             END ;
                     END ;
             END
        ELSE ErrorMessage (5) ;
     END ; { of with }
CopyBlock := Result ;
END ;

{-----------------------------------------------------------------------------}
{ Deletes the block from the current workspace.                               }
{-----------------------------------------------------------------------------}

PROCEDURE DeleteBlock ;

VAR OldCurPosIndex : WORD ;

BEGIN
WITH CurrentWs DO
     BEGIN
     IF MARK > 0
        THEN BEGIN
             IF MARK < CurPos.Index
                THEN BEGIN
                     { if Mark is before CurPos: exchange positions }
                     OldCurPosIndex := CurPos.Index ;
                     SkipUp (CurPos, OldCurPosIndex - MARK) ;
                     MARK := OldCurPosIndex ;
                     END ;
             Shrink (CurPos.Index, MARK - CurPos.Index) ;
             MARK := 0 ;
             END ;
     END ;
END ;

{-----------------------------------------------------------------------------}
{ Inserts the contents of the paste buffer into the current workspace at      }
{ position CurPos. If successful, Mark will be pointing to the end of the     }
{ inserted block, and CurPos to the start. Function result indicates success. }
{-----------------------------------------------------------------------------}

FUNCTION InsertBlock : BOOLEAN ;

BEGIN
WITH CurrentWs DO
     BEGIN
     IF Grow (CurPos.Index, PasteBufferSize)
        THEN BEGIN
             MOVE (PasteBuffer^ [1], Buffer^ [CurPos.Index], PasteBufferSize) ;
             InsertBlock := TRUE
             END
        ELSE InsertBlock := FALSE;
     END ; { of with }
END ;

{-----------------------------------------------------------------------------}
{ Dumps a block (indicated by BlockStart and BlockEnd) to the printer.        }
{ If enabled by Setup, form feeds, left and top margins and page numbers      }
{ are added.                                                                  }
{-----------------------------------------------------------------------------}

PROCEDURE PrintBlock (Buffer : WsBufptr ; BlockStart, BlockEnd : WORD ) ;

VAR Counter, IndexCounter, LineCounter, PageCounter, LinesPerPage : WORD ;
    DummyKey : WORD ;
    AbortPrint : BOOLEAN ;

BEGIN
{ LinesPerPage contains number of text lines on a page }
LinesPerPage := Config.Setup.PageLength ;
IF Config.Setup.PrintPagenrs THEN DEC (LinesPerPage, 2) ;
Message ('Printing. Press any key to interrupt') ;
AbortPrint := FALSE ;
IndexCounter := BlockStart ;
PageCounter := 1 ;
{ write top margin of first page }
FOR Counter := 1 TO Config.Setup.TopMargin DO
    WRITELN (Lst) ;
LineCounter := Config.Setup.TopMargin + 1 ;
{ write left margin of first line }
WRITE (Lst, '' : Config.Setup.LeftMargin) ;
REPEAT IF Buffer^ [IndexCounter] <> FF
          THEN WRITE (Lst, Buffer^ [IndexCounter]) ;
       IF Buffer^ [IndexCounter] = LF
          THEN BEGIN
               INC (LineCounter) ;
               { write left margin of new line }
               WRITE (Lst, '' : Config.Setup.LeftMargin) ;
               END ;
       IF ( (LineCounter > LinesPerPage) AND (Config.Setup.PageLength > 0) ) OR
          (Buffer^ [IndexCounter] = FF)
          THEN BEGIN
               { end current page and start new one }
               IF Config.Setup.PrintPagenrs
                  THEN BEGIN
                       { print page number if desired }
                       WHILE LineCounter <= (LinesPerPage + 2) DO
                             BEGIN
                             WRITELN (Lst) ;
                             INC (LineCounter) ;
                             END ;
                       WRITE (Lst, '' : Config.Setup.LeftMargin,
                                  'Pag ', PageCounter : 2) ;
                       END ;
               WRITE (Lst, FF) ;
               INC (PageCounter) ;
               { skip top margin }
               FOR Counter := 1 TO Config.Setup.TopMargin DO
                   WRITELN (Lst) ;
               LineCounter := Config.Setup.TopMargin + 1 ;
               { write left margin of first line }
               WRITE (Lst, '' : Config.Setup.LeftMargin) ;
               END ;
       INC (IndexCounter) ;
       CheckDiskError ;
       AbortPrint := (DiskError <> 0) ;
       IF KEYPRESSED
          THEN BEGIN
               ClearKeyBuffer ;
               { ask for confirmation }
               AbortPrint := Answer ('Abort printing?') ;
               IF NOT AbortPrint
                  THEN Message ('Printing. Press any key to interrupt') ;
               END ;
UNTIL (IndexCounter > BlockEnd) OR AbortPrint ;
IF (Config.Setup.PrintPagenrs) AND (NOT KEYPRESSED)
   THEN BEGIN
        { end last page: move to end of page and print page number }
        FOR Counter := LineCounter TO (LinesPerPage + 1) DO
            WRITELN (Lst) ;
        WRITE (Lst, 'Pag ', PageCounter : 2) ;
        WRITE (Lst, FF) ;
        CheckDiskError ;
        END ;
IF AbortPrint
   THEN Message ('Printing aborted')
   ELSE Message ('Printing completed') ;
END ;

{-----------------------------------------------------------------------------}
{ Inserts the file <Filename> into the current workspace at position P.       }
{-----------------------------------------------------------------------------}

PROCEDURE InsertFile (Filename : PathStr ; P : Position) ;

VAR F : FILE ;
    Size, BytesToRead, AvailableSpace : LONGINT ;
    BytesRead : WORD ;
    Counter : WORD ;

BEGIN
ASSIGN (F, Filename) ;
RESET (F, 1) ;
CheckDiskError ;
IF (DiskError = 0)
   THEN BEGIN
        Size := FILESIZE (F) ;
        WITH CurrentWs DO
             BEGIN
             BytesToRead := Size ;
             AvailableSpace := WsBufSize - BufferSize ;
             IF BytesToRead > AvailableSpace
                THEN BytesToRead := AvailableSpace ;
             IF Grow (P.Index, BytesToRead)
                THEN BEGIN
                     Message ('Reading file ' + Filename + ' ...') ;
                     BLOCKREAD (F, Buffer^ [P.Index], BytesToRead, BytesRead) ;
                     CheckDiskError ;
                     MARK := P.Index + BytesRead ;
                     { check for EndOfFile char }
                     IF (Buffer^ [P.Index+BytesRead-1] = EF)
                        THEN BEGIN
                             { always delete if it is last char read }
                             Shrink (P.Index+BytesRead-1, 1) ;
                             Dec (BytesRead) ;
                             END ;
                     { check for other }
                     Counter := P.Index ;
                     WHILE (Buffer^ [Counter] <> EF) AND
                           (Counter < (P.Index+BytesRead)) DO
                           INC (Counter) ;
                     { delete stuff after EOF char }
                     IF (Counter < (P.Index+BytesRead)) AND
                        (Answer ('Unexpected end-of-file encountered. ' +
                                 'Truncate file?'))
                        THEN Shrink (Counter,
                                     BytesRead - (Counter - P.Index) ) ;
                     Message ('') ;
                     END ; { of if }
             IF Size > BytesToRead
                THEN { warning: file too large to load completely }
                     ErrorMessage (7) ;
             CLOSE (F) ;
             END ; { of with }
        END ; { of if }
END ; { of procedure }

{-----------------------------------------------------------------------------}
{ Loads the file <Filename> into the current workspace, resetting all         }
{ variables involved. If <Filename> is empty, then no file is loaded.         }
{-----------------------------------------------------------------------------}

PROCEDURE LoadFile (Filename : PathStr) ;

BEGIN
ClearCurrentWs ;
IF LENGTH (FileName) > 0
   THEN WITH CurrentWs DO
             BEGIN
             Name := FExpand (Filename) ;
             InsertFile (Name, CurPos) ;
             MARK := Inactive ;
             ChangesMade := FALSE ;
             END ;
Workspace [CurrentWsnr] := CurrentWs ;
END ;

{-----------------------------------------------------------------------------}
{ Displays a list with files, from which the user                             }
{ can then make a choice, using the cursor and Return keys.                   }
{ Cursor shape and position and screen contents are saved, and                }
{ restored on exit.                                                           }
{-----------------------------------------------------------------------------}

PROCEDURE GetFileFromList (VAR Name : PathStr) ;

VAR OldXpos, OldYpos, OldCursorType, Counter : BYTE ;
    OldAttr, NormAttr, SelectAttr : BYTE ;
    OldDisplayContents : ScreenBlockPtr ;
    SelectKey : WORD ;
    FileList : ARRAY [1..MaxFileListLength] OF FilenameStr ;
    FirstVisibleFile, SelectedFile, FileListLength : BYTE ;
    SR : SearchRec ;
    Mask : FilenameStr ;
    Dir, OldCurrentDir : DirStr ;
    Fname : NameStr ;
    Fext : ExtStr ;

BEGIN
GETDIR (0, OldCurrentDir) ;
{ split pathname into directory and mask }
FSplit (FExpand (Name), Dir, Fname, Fext) ;
Mask := Fname + Fext ;
IF LENGTH (Dir) > 3
   THEN DELETE (Dir, LENGTH (Dir), 1) ;
CHDIR (Dir) ;
CheckDiskError ;
{ save old screen settings }
OldXpos := WHEREX ;
OldYpos := WHEREY ;
OldCursorType := GetCursor ;
OldAttr := TextAttr ;
{ new screen settings }
SetCursor (Inactive) ;
NormAttr := ScreenColorArray [Config.Setup.ScreenColors].NormAttr ;
SelectAttr := ScreenColorArray [Config.Setup.ScreenColors].BlockAttr ;
TextAttr := NormAttr ;
{ save old screen contents and draw frame for file list }
SaveArea (60, 2, 75, 23, OldDisplayContents) ;
PutFrame (60, 2, 75, 23, Quasi3DFrame) ;
ClearArea (61, 3, 74, 22) ;
REPEAT Counter := 1 ;
       Message ('Searching ...') ;
       { build file list }
       FINDFIRST (Mask, ReadOnly + Archive, SR) ;
       WHILE (DosError = 0) AND (Counter < (MaxFileListLength - 1) ) DO
             BEGIN
             FileList [Counter] := SR.Name ;
             FINDNEXT (SR) ;
             INC (Counter) ;
             END ;
       { add directories }
       FINDFIRST ('*.*', Directory, SR) ;
       WHILE (DosError = 0) AND (Counter <= MaxFileListLength) DO
             BEGIN
             IF ( (SR.Attr AND Directory) <> 0) AND
                (SR.Name <> '.')
                THEN BEGIN
                     FileList [Counter] := 'Ø' + SR.Name ;
                     INC (Counter) ;
                     END ;
             FINDNEXT (SR) ;
             END ;
       Message ('Select file with ,,PgUp, PgDn keys, or ' +
                'press first letter; Enter to load') ;
       FileListLength := Counter - 1 ;
       FirstVisibleFile := 1 ;
       SelectedFile := 1 ;
       REPEAT IF FirstVisibleFile > SelectedFile
                 THEN FirstVisibleFile := SelectedFile ;
              IF (SelectedFile - FirstVisibleFile) > 19
                 THEN FirstVisibleFile := SelectedFile - 19 ;
              FOR Counter := FirstVisibleFile TO (FirstVisibleFile + 19) DO
                  BEGIN
                  IF Counter = SelectedFile
                     THEN TextAttr := SelectAttr
                     ELSE TextAttr := NormAttr ;
                  GOTOXY (61, Counter - FirstVisibleFile + 3) ;
                  IF Counter <= FileListLength
                     THEN WRITE (' ', FileList [Counter],
                                 ' ' : (13 - LENGTH (FileList [Counter]) ) )
                     ELSE WRITE (' ' : 14) ;
                  END ;
              SelectKey := ReadKeyNr ;
              CASE SelectKey OF
                   328 : { up    } IF SelectedFile > 1
                                      THEN DEC (SelectedFile) ;
                   336 : { down  } IF SelectedFile < FileListLength
                                      THEN INC (SelectedFile) ;
                   329 : { PgUp  } IF SelectedFile > 19
                                      THEN DEC (SelectedFile, 19)
                                      ELSE SelectedFile := 1 ;
                   337 : { PgDn  } IF SelectedFile < (FileListLength - 19)
                                      THEN INC (SelectedFile, 19)
                                      ELSE SelectedFile := FileListLength ;
                   388 : { ^PgUp } SelectedFile := 1 ;
                   374 : { ^PgDn } SelectedFile := FileListLength ;
                   32..127   : BEGIN
                               { select by pressing first letter of name }
                               Counter := SelectedFile + 1 ;
                               WHILE (NOT ( (FileList [Counter] [1] =
                                            UPCASE (CHR (SelectKey) ) ) OR
                                           ( (FileList [Counter] [1] = 'Ø') AND
                                            (FileList [Counter] [2] =
                                             UPCASE (CHR (SelectKey) ) ) ) ) )
                                     AND
                                     (Counter <= FileListLength)
                                     DO INC (Counter) ;
                               IF Counter <= FileListLength
                                  THEN SelectedFile := Counter ;
                               END ;
                   ReturnKey : ;
                   EscapeKey : EscPressed := TRUE ;
                   ELSE        WarningBeep ; { invalid key }
                   END ; { of case }
       UNTIL (SelectKey = ReturnKey) OR EscPressed ;
       IF (SelectKey = ReturnKey) AND (FileList [SelectedFile] [1] = 'Ø')
          THEN CHDIR (COPY (FileList [SelectedFile], 2, 8) ) ;
UNTIL (FileList [SelectedFile] [1] <> 'Ø') OR EscPressed ;
{ restore screen }
Message ('') ;
RestoreArea (60, 2, 75, 23, OldDisplayContents) ;
TextAttr := OldAttr ;
GOTOXY (OldXpos, OldYpos) ;
SetCursor (OldCursorType) ;
{ construct full pathname from filename + directory }
IF NOT EscPressed
   THEN { change wildcarded name into name of selected file }
        BEGIN
        GETDIR (0, Dir) ;
        IF Dir [LENGTH (Dir) ] <> '\' THEN Dir := Dir + '\' ;
        Name := Dir + FileList [SelectedFile] ;
        END ;
CHDIR (OldCurrentDir) ;
END ;

{-----------------------------------------------------------------------------}
{ Insert a number of spaces into the current workspace at position P.         }
{ On exit, P will point to the position right after the last space.           }
{-----------------------------------------------------------------------------}

PROCEDURE InsertSpaces (VAR P : Position ; NrOfSpaces : WORD) ;

BEGIN
WITH CurrentWs DO
     BEGIN
     IF Grow (P.Index, NrOfSpaces)
        THEN BEGIN
             FILLCHAR (Buffer^ [P.Index], NrOfSpaces, ' ') ;
             INC (P.Index, NrOfSpaces) ;
             INC (P.Colnr, NrOfSpaces) ;
             END
     END ; { of with }
END ;

{-----------------------------------------------------------------------------}
{ Insert a carriage return - line feed pair into the current workspace at     }
{ position P. If autoindent is on, the left margin of the current line is     }
{ determined, and the same number of spaces inserted at the beginning of the  }
{ new line.                                                                   }
{-----------------------------------------------------------------------------}

PROCEDURE InsertCRLF (VAR P : Position) ;

VAR Counter, LM : WORD ;

BEGIN
WITH CurrentWs DO
     BEGIN
     LM := LeftMargin (P) ;
     IF Grow (P.Index, 2)
        THEN BEGIN
             Buffer^ [P.Index] := CR ;
             Buffer^ [P.Index + 1] := LF ;
             INC (P.Index, 2) ;
             INC (P.Linenr) ;
             P.Colnr := 1 ;
             IF Config.Setup.AutoIndent
                THEN InsertSpaces (P, LM - 1) ;
             END ;
     END ; { of with }
END ;

{-----------------------------------------------------------------------------}
{ Redraws the entire screen, including the status line                        }
{-----------------------------------------------------------------------------}

PROCEDURE RedrawScreen ;

VAR LineCounter             : BYTE ;
    IndexCounter, ColCounter : WORD ;
    BlockStart, BlockStop    : WORD ;
    NormAttr, BlockAttr      : BYTE ;
    ScreenChar              : ScreenElement ;
    ScreenCharPtr           : ScreenElementPtr ;
    LastScreenCol           : WORD ;
    SpacesToInsert          : WORD ;
    CursorY                 : BYTE ;
    StatusLine              : STRING [ColsOnScreen] ;
    TempStr                 : STRING [5] ;
    FileName                : STRING ;

BEGIN
WITH CurrentWs DO
     BEGIN
     { check if FirstVisibleLine needs to be adapted }
     IF (FirstVisibleLine.Linenr > CurPos.Linenr)
        THEN
          BEGIN
          { line number of CurPos is too low }
          FirstVisibleLine := CurPos ;
          Home (FirstVisibleLine) ;
          END ;
     IF ( (FirstVisibleLine.Linenr + NrOfTextLines) <= CurPos.Linenr)
        THEN
          BEGIN
          { line number of CurPos is too high }
          IF ( (FirstVisibleLine.Linenr + 2 * NrOfTextLines) <= CurPos.Linenr)
             THEN
               BEGIN
               { difference is more than 1 screen }
               FirstVisibleLine := CurPos ;
               REPEAT
                 LineUp (FirstVisibleLine) ;
               UNTIL ( (FirstVisibleLine.Linenr + NrOfTextLines) =
                      (CurPos.Linenr + 1) ) ;
               END
             ELSE
               BEGIN
               { difference is less than 1 screen }
               WHILE ( (FirstVisibleLine.Linenr + NrOfTextLines) <=
                      CurPos.Linenr) DO
                     BEGIN
                     LineDown (FirstVisibleLine) ;
                     END ;
               END ;
          END ;
     { adapt FirstScreenCol if necessary }
     IF FirstScreenCol > CurPos.Colnr
        THEN { cursor is before FirstScreenCol }
             FirstScreenCol := CurPos.Colnr ;
     IF (FirstScreenCol + ColsOnScreen) <= CurPos.Colnr
        THEN { cursor is more than 1 screenwidth after FirstScreenCol }
             FirstScreenCol := CurPos.Colnr - ColsOnScreen + 1 ;
     { determine line on screen where cursor must be put }
     CursorY := CurPos.Linenr - FirstVisibleLine.Linenr + 1 ;
     { set index of first and last characters to be displayed as part of block }
     IF (MARK <> Inactive)
        THEN
          BEGIN
          IF MARK < CurPos.Index
             THEN
               BEGIN
               BlockStart := MARK ;
               BlockStop := CurPos.Index ;
               END
             ELSE
               BEGIN
               BlockStart := CurPos.Index ;
               BlockStop := MARK ;
               END
          END
        ELSE
          BEGIN
          { do not show a block on the screen }
          BlockStart := $FFFF ;
          BlockStop := 0 ;
          END ;
     { Initialize working variables: }
     { ScreenCharPtr starts at top of screen }
     ScreenCharPtr := ScreenElementPtr (DisplayPtr) ;
     { NormAttr contains attribute of normal characters on screen }
     NormAttr := ScreenColorArray [Config.Setup.ScreenColors].NormAttr ;
     { BlockAttr contains attribute of characters in block }
     BlockAttr := ScreenColorArray [Config.Setup.ScreenColors].BlockAttr ;
     { IndexCounter contains index of next character to be displayed }
     IndexCounter := FirstVisibleLine.Index ;
     { LastScreenCol contains number of last column on screen }
     LastScreenCol := FirstScreenCol + ColsOnScreen - 1 ;
     { write text lines to screen }
     FOR LineCounter := 1 TO NrOfTextLines DO
         BEGIN
         { initialise attribute of characters on screen }
         IF (IndexCounter >= BlockStart) AND (IndexCounter < BlockStop)
            THEN ScreenChar.Attribute := BlockAttr
            ELSE ScreenChar.Attribute := NormAttr ;
         { SpacesToInsert counts extra spaces, shown because of CR,LF,EF }
         SpacesToInsert := 0 ;
         { write line only if no key in buffer or if on current line }
         IF (Config.Setup.FastRedraw) AND
            (KEYPRESSED) AND
            ( (LineCounter > CursorY) OR
             (LineCounter < (CursorY - 2) ) )
            THEN { skip writing this line }
                 INC (ScreenCharPtr.OFS, 2 * ColsOnScreen)
            ELSE FOR ColCounter := 1 TO LastScreenCol DO
                     BEGIN
                     { check if at end of buffer }
                     IF IndexCounter = BufferSize
                        THEN SpacesToInsert := LastScreenCol ;
                     IF SpacesToInsert > 0
                        THEN BEGIN
                             ScreenChar.Contents := ' ' ;
                             END
                        ELSE BEGIN
                             { change attribute if necessary }
                             IF IndexCounter = BlockStart
                                THEN ScreenChar.Attribute := BlockAttr ;
                             IF IndexCounter = BlockStop
                                THEN ScreenChar.Attribute := NormAttr ;
                             ScreenChar.Contents := Buffer^ [IndexCounter] ;
                             CASE ScreenChar.Contents OF
                                  ' ' : IF Config.Setup.DotsForSpaces
                                           THEN ScreenChar.contents := #250 ;
                                  CR  : IF Buffer^ [IndexCounter + 1] = LF
                                           THEN BEGIN
                                                ScreenChar.contents := ' ' ;
                                                SpacesToInsert :=
                                                             LastScreenCol ;
                                               END ;
                                  LF  : BEGIN
                                        ScreenChar.contents := ' ' ;
                                        SpacesToInsert := LastScreenCol ;
                                        END ;
                                  END ; { of case }
                             END ;
                     IF ColCounter >= FirstScreenCol
                        THEN BEGIN
                             { write ScreenChar to screen }
                             ScreenCharPtr.Ref^ := ScreenChar ;
                             INC (ScreenCharPtr.OFS, 2) ;
                             END ;
                     IF SpacesToInsert = 0
                        THEN INC (IndexCounter)
                        ELSE DEC (SpacesToInsert) ;
                     END ; { of for }
         { skip to next line }
         IF IndexCounter < BufferSize THEN
            REPEAT INC (IndexCounter) ;
            UNTIL (Buffer^ [IndexCounter - 1] = LF) OR
                  (IndexCounter = BufferSize) ;
         END ; { of for }
     { status line: }
     IF MessageRead
        THEN
          BEGIN
          { prepare status line }
          StatusLine := BasicStatusLine ;
          StatusLine [1] := CHR (64 + CurrentWsnr) ;
          TempStr := WordToString (CurPos.Linenr, 0) ;
          MOVE (TempStr [1], StatusLine [6], LENGTH (TempStr) ) ;
          TempStr := WordToString (CurPos.Colnr, 0) ;
          MOVE (TempStr [1], StatusLine [14], LENGTH (TempStr) ) ;
          IF ChangesMade
             THEN StatusLine [20] := '*' ;
          IF LENGTH (Name) <= 34
             THEN MOVE (Name [1], StatusLine [22], LENGTH (Name) )
             ELSE BEGIN
                  { select last part of file name and prepend with 'Æ' }
                  FileName := COPY (Name, LENGTH (Name) - 34 + 2, 33) ;
                  DELETE (FileName, 1, POS ('\', FileName) ) ;
                  FileName := 'Æ' + FileName ;
                  MOVE (FileName [1], StatusLine [22], LENGTH (FileName) ) ;
                  END ;
          IF Config.Setup.WordWrapLength <> Inactive
             THEN MOVE (Status_Wrap [1], StatusLine [57], 4) ;
          IF Config.Setup.Insertmode
             THEN MOVE (Status_Ins [1], StatusLine [62], 3) ;
          IF Config.Setup.AutoIndent
             THEN MOVE (Status_Indent [1], StatusLine [66], 6) ;
          IF MacroDefining <> Inactive
             THEN MOVE (Status_Def [1], StatusLine [73], 3) ;
          TempStr := WordToString (LONGINT (CurPos.Index) * 100 DIV BufferSize,
                                   3) ;
          MOVE (TempStr [1], StatusLine [77], 3) ;
          { show status line on screen }
          SetBottomline (StatusLine) ;
          END ;
     { set position of cursor }
     CursorTo (CurPos.Colnr - FirstScreenCol + 1, CursorY) ;
     END ; { of with }
END ; { of procedure }

{-----------------------------------------------------------------------------}
{ Choose a set option that can be on or of                                    }
{-----------------------------------------------------------------------------}

PROCEDURE ChooseOnOff (VAR B : BOOLEAN ; Prompt : STRING) ;

VAR Choices : STRING[7] ;

BEGIN
IF B
   THEN Choices := 'On  oFf'
   ELSE Choices := 'oFf On' ;
CASE Choose (Choices, Prompt) OF
     'O' : B := TRUE ;
     'F' : B := FALSE ;
     END ;
END ;

{-----------------------------------------------------------------------------}
{ Interactive change of the setup                                             }
{-----------------------------------------------------------------------------}

PROCEDURE AlterSetup ;

VAR Choices : STRING ;
    ConfigFile : FILE OF ConfigBlock ;
    SetupDir : DirStr ;

BEGIN
WITH Config.Setup DO
  BEGIN
  CASE Choose ('Display  Environment  File  Printer  Save-setup','Setup: ') OF
      'D' : CASE Choose ('Colors  cursorType  Fastredraw Dots-for-spaces','Display: ') OF
              'C' : BEGIN
                    IF ColorCard
                       THEN BEGIN
                            IF ScreenColors = NrOfColorSettings
                               THEN Screencolors := 1
                               ELSE INC (ScreenColors) ;
                            END
                       ELSE BEGIN
                            IF ScreenColors = 1
                               THEN Screencolors := 2
                               ELSE Screencolors := 1 ;
                            END ;
                    TextAttr := ScreenColorArray [ScreenColors].NormAttr ;
                    END ;
              'T' : BEGIN
                    IF Cursortype = NrOfCursorTypes
                       THEN Cursortype := 1
                       ELSE INC (Cursortype) ;
                    SetCursor (CursorType) ;
                    END ;
              'F' : ChooseOnOff (FastRedraw,'Fast screen redraw: ') ;
              'D' : ChooseOnOff (DotsForSpaces,
                                 'Display spaces as small dots: ') ;
              END ; { of case }
      'E' : CASE Choose ('Keyclick  Bell  Wordwrap  Tabs  Autoindent  Insert',
                         'Environment: ') OF
              'K' : ChooseOnOff (Keyclick, 'Key click: ') ;
              'B' : ChooseOnOff (SoundBell,
                                 'Sound bell on errors and warnings: ') ;
              'W' : CASE Choose ('Linelength  Automatic','Word wrap: ') OF
                      'L' : EnterWord (WordWrapLength,
                             'Line length for word wrap (0 = off): ', 0, 255) ;
                      'A' : ChooseOnOff (AutoWrap, 'Automatic wordwrap: ') ;
                      END ; { of case }
              'T' : Enterword (TabSpacing, 'Tab spacing (0 = align): ', 0, 255) ;
              'A' : ChooseOnOff (AutoIndent, 'Auto indent: ') ;
              'I' : ChooseOnOff (InsertMode, 'Insert mode: ')
              END ; { of case }
      'F' : CASE Choose ('Exit-auto-save  Interval-auto-save  Backup-files  Workfile',
                         'Filing: ') OF
              'E' : ChooseOnOff (SaveOnExit,
                                 'Save changed files on exiting AE: ') ;
              'I' : EnterWord (SaveInterval,
                               'Interval for auto-save in minutes (0 = off): ',
                                0, 1000) ;
              'B' : ChooseOnOff (MakeBAKfile, 'Make .BAK file when saving: ') ;
              'W' : ChooseOnOff (SaveWork, 'Save workspace on exit: ') ;
              END ; { of case }
      'P' : CASE Choose ('Page-length  Left-margin  Top-margin  page-Numbers',
                         'Printer: ') OF
              'P' : EnterWord (PageLength,
                               'Lines per page for paged prints (0 = off): ',
                               0, 1000) ;
              'L' : EnterWord (LeftMargin, 'Left margin: ', 0, 240) ;
              'T' : EnterWord (TopMargin, 'Top margin: ', 0, 1000) ;
              'N' : ChooseOnOff (PrintPagenrs, 'Print page numbers: ') ;
              END ; { of case }
      'S' : BEGIN
            GETDIR (0,SetupDir) ;
            EnterString (SetupDir, NIL, 'Save setup in directory: ',
                         67, TRUE, TRUE) ;
            IF NOT EscPressed
               THEN
                 BEGIN
                 ASSIGN (ConfigFile, SetupDir+'\'+ConfigFilename) ;
                 REWRITE (ConfigFile) ;
                 WRITE (ConfigFile, Config) ;
                 CheckDiskerror ;
                 CLOSE (ConfigFile) ;
                 IF DiskError = 0
                    THEN Message (Copy('Setup saved as '+SetupDir+'\'+
                                  ConfigFilename, 1, 80)) ;
                 END ;
            END ;
      END ; { of case }
  END ; { of with }
END ;

{-----------------------------------------------------------------------------}
{ Formats text, starting from position P until the next empty line            }
{-----------------------------------------------------------------------------}

PROCEDURE FormatParagraph (VAR P : position) ;

VAR Index2, Index3 : WORD ;
    FreeSpace : WORD ;
    Margin : WORD ;
    Ready : BOOLEAN ;
    LFsseen : WORD ;
    Counter : WORD ;

BEGIN
WITH CurrentWs DO
     BEGIN
     { advance P to the end of this word, to avoid deleting the left margin }
     { (delimited by a space, CR, LF or EF) }
     LFsseen := 0 ;
     WHILE (Buffer^[P.Index] IN WordDelimiters) AND
           (P.Index < BufferSize) DO
           BEGIN
           IF Buffer^[P.Index] = LF
              THEN BEGIN
                   INC (P.Linenr) ;
                   INC (LFsseen) ;
                   P.Colnr := 1 ;
                   END
              ELSE INC (P.Colnr) ;
           INC (P.Index) ;
           END ;
     WHILE (NOT (Buffer^[P.Index] IN WordDelimiters)) AND
           (P.Index < BufferSize) DO
           BEGIN
           INC (P.Colnr) ;
           INC (P.Index) ;
           END ;
     { calculate left margin }
     IF Config.Setup.AutoIndent
        THEN Margin := LeftMargin (P)
        ELSE Margin := 1 ;
     { move rest of text to back of buffer }
     FreeSpace := WsBufSize-BufferSize ;
     IF Grow (P.Index, FreeSpace)
        THEN BEGIN
             { set Index2 and Index3 to start of rest of text }
             Index2 := P.Index + FreeSpace ;
             Index3 := Index2 ;
             Ready := (LFsseen > 0) ;
             WHILE NOT Ready DO
                   BEGIN
                   { advance Index2 to start of next word, }
                   { counting linefeeds skipped }
                   LFsseen := 0 ;
                   WHILE (Buffer^[Index2] IN WordDelimiters) AND
                         (Index2 < BufferSize) DO
                         BEGIN
                         IF Buffer^[Index2] = LF
                            THEN INC (LFsseen) ;
                         INC (Index2) ;
                         END ;
                   Ready := (LFsseen > 1) OR (Index2 >= BufferSize) ;
                   IF NOT Ready
                      THEN BEGIN
                           { advance Index3 to the end of the word }
                           Index3 := Index2 ;
                           WHILE (NOT (Buffer^[Index3] IN WordDelimiters)) AND
                                 (Index3 < BufferSize) DO
                                 INC (Index3) ;
                           { test if adding word would make line too long }
                           IF P.Colnr + (Index3-Index2) >
                              Config.Setup.WordWrapLength
                              THEN BEGIN
                                   { break line after P (if enough room) }
                                   IF (P.Index-Index2) >= (Margin + 1)
                                      THEN BEGIN
                                           Buffer^[P.Index] := CR ;
                                           Buffer^[P.Index+1] := LF ;
                                           FOR Counter := 1 TO (Margin-1) DO
                                               Buffer^[P.Index+1+Counter] :=
                                                                        ' ' ;
                                           INC (P.Index, Margin+1) ;
                                           P.Colnr := Margin ;
                                           INC (P.Linenr) ;
                                           END
                                      ELSE BEGIN
                                           { not enough room to do formatting }
                                           ErrorMessage (1) ;
                                           Ready := TRUE ;
                                           END ;
                                   END
                              ELSE BEGIN
                                   { put 1 space after P (if enough room) }
                                   IF (P.Index-Index2) >= 1
                                      THEN BEGIN
                                           Buffer^[P.Index] := ' ' ;
                                           INC (P.Index) ;
                                           INC (P.Colnr) ;
                                           END
                                      ELSE BEGIN
                                           { not enough room to do formatting }
                                           ErrorMessage (1) ;
                                           Ready := TRUE ;
                                           END ;
                                   END ;
                           { move word between Index2 and Index3 to P }
                           MOVE (Buffer^[Index2], Buffer^[P.Index],
                                 (Index3-Index2)) ;
                           { adjust P }
                           INC (P.Index, Index3-Index2) ;
                           INC (P.Colnr, Index3-Index2) ;
                           { advance Index2 }
                           Index2 := Index3 ;
                           END ; { of if }
                   END ; { of while }
             { move remainder of text back, to just after formatted block }
             Shrink (P.Index, Index3-P.Index) ;
             END ; { of if }
     END ; { of with }
END ;

{-----------------------------------------------------------------------------}

END.